home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff2.arc / ALBUMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-23  |  17.0 KB  |  565 lines
  1.  
  2. PROGRAM ALBUM_INVENTORY;
  3.  
  4. TYPE CATAGORY = (POP,ROCK,EASY_LISTENING,CLASSICAL,COUNTRY,MISCELLANEOUS);
  5.      ALBUMS = RECORD
  6.                 ARTIST:STRING[40];
  7.                 TITLE:STRING[50];
  8.                 CAT:STRING[14];
  9.                 COST:REAL;
  10.               END;  (* ALBUMS *)
  11.      INVENTORY = ARRAY[1..200] OF ALBUMS;
  12.      STRNG = STRING[14];
  13.  
  14. VAR ARTIST:STRING[40];
  15.     TITLE:STRING[50];
  16.     CAT:INTEGER;
  17.     CT:INTEGER;
  18.     ALBUM:INVENTORY;
  19.     RECDAT:TEXT;
  20.     SEL:INTEGER;
  21.     NUMRECS:INTEGER;
  22.     FILEREAD:BOOLEAN;
  23.     CATSTR:STRING[14];
  24. (****************************************************************************)
  25. PROCEDURE ALPHABETIZE(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  26. VAR I,J,SMALL:INTEGER;
  27.     TEMP:ALBUMS;
  28. BEGIN
  29.   WRITELN('ALPHABETIZING THE RECORDS.');
  30.   FOR I:=1 TO NUMRECS-1 DO
  31.     BEGIN
  32.       SMALL:=I;
  33.       FOR J:=I+1 TO NUMRECS DO
  34.        IF ALBUM[J].ARTIST < ALBUM[SMALL].ARTIST THEN
  35.           SMALL:=J;
  36.       TEMP:=ALBUM[I];
  37.       ALBUM[I]:=ALBUM[SMALL];
  38.       ALBUM[SMALL]:=TEMP;
  39.     END;
  40. END;  (* PROCEDURE ALPHABETIZE *)
  41. (****************************************************************************)
  42. PROCEDURE SEARCH_ARTIST(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  43. VAR ARTSTR:STRING[40];
  44.     CT,COUNT:INTEGER;
  45.     FOUND:BOOLEAN;
  46.     MORE:CHAR;
  47. BEGIN
  48.   MORE:='Y';
  49.   WHILE MORE='Y' DO
  50.     BEGIN
  51.       MORE:='N';
  52.       FOUND:=FALSE;
  53.       CLRSCR;
  54.       WRITE('ENTER ARTIST''S NAME TO SEARCH FOR : ');
  55.       READLN(ARTSTR);
  56.       CLRSCR;
  57.       WRITELN('TITLES AVAILABLE BY ',ARTSTR,' ARE :');
  58.       WRITELN;
  59.       COUNT:=0;
  60.       FOR CT:=1 TO NUMRECS DO
  61.         IF POS(ARTSTR,ALBUM[CT].ARTIST)<>0 THEN
  62.           BEGIN
  63.             FOUND:=TRUE;
  64.             WRITELN('FOUND ALBUM # ',CT:3,'  ',ALBUM[CT].TITLE);
  65.             WRITELN('LISTED UNDER ',ALBUM[CT].CAT);
  66.             IF ALBUM[CT].ARTIST<>ARTSTR THEN
  67.               WRITELN('ARTIST''S FULL NAME IS : ',ALBUM[CT].ARTIST);
  68.             WRITELN;
  69.             COUNT:=COUNT+1
  70.           END;
  71.       IF FOUND THEN
  72.         WRITELN('TOTAL OF ',COUNT,' ALBUMS AVAILABLE BY ',ARTSTR,'.')
  73.       ELSE
  74.         WRITELN('COULDN''T FIND ANYTHING BY ',ARTSTR,'.');
  75.       WRITELN;
  76.       WRITE('WOULD YOU LIKE TO SEARCH BY ARTIST AGAIN?   Y/N  : ');
  77.       READLN(MORE);
  78.     END;
  79. END;  (* PROCEDURE SEARCH_ARTIST *)
  80. (****************************************************************************)
  81. PROCEDURE WRITE_CATS;
  82.   BEGIN
  83.     WRITELN;
  84.     WRITELN('AVAILABLE CATAGORIES ARE :');
  85.     WRITELN;
  86.     WRITELN('1. POP');
  87.     WRITELN('2. ROCK');
  88.     WRITELN('3. JAZZ');
  89.     WRITELN('4. R & B');
  90.     WRITELN('5. COUNTRY');
  91.     WRITELN('6. CLASSICAL');
  92.     WRITELN('7. EASY LISTENING');
  93.     WRITELN('8. MISCELLANEOUS');
  94.     WRITELN
  95.   END;  (* PROCEDURE WRITE_CATS *)
  96. (****************************************************************************)
  97. PROCEDURE GET_CATSTR(CAT:INTEGER;VAR CATSTR:STRNG);
  98. BEGIN
  99.   CASE CAT OF
  100.     1:CATSTR:='POP';
  101.     2:CATSTR:='ROCK';
  102.     3:CATSTR:='JAZZ';
  103.     4:CATSTR:='R & B';
  104.     5:CATSTR:='COUNTRY';
  105.     6:CATSTR:='CLASSICAL';
  106.     7:CATSTR:='EASY LISTENING';
  107.     8:CATSTR:='MISCELLANEOUS';
  108.   END;  (* CASE STATEMENT *)
  109. END;  (* PROCEDURE GET_CATSTR *)
  110. (****************************************************************************)
  111. PROCEDURE SEARCH_TITLE(VAR ALBUM:INVENTORY; NUMRECS:INTEGER);
  112. VAR TITSTR:STRING[50];
  113.     CT,COUNT:INTEGER;
  114.     MORE:CHAR;
  115.     FOUND:BOOLEAN;
  116.     CATSTR:STRING[14];
  117. BEGIN
  118.   MORE:='Y';
  119.   WHILE MORE='Y' DO
  120.     BEGIN
  121.       CLRSCR;
  122.       WRITE('ENTER TITLE TO SEARCH FOR : ');
  123.       READLN(TITSTR);
  124.       CLRSCR;
  125.       WRITELN('SEARCHING FOR : ',TITSTR);
  126.       WRITELN;
  127.       FOUND:=FALSE;
  128.       FOR CT:=1 TO NUMRECS DO
  129.         IF POS(TITSTR,ALBUM[CT].TITLE)<>0 THEN
  130.           BEGIN
  131.             IF TITSTR<>ALBUM[CT].TITLE THEN
  132.               BEGIN
  133.              WRITELN('FOUND ALBUM # ',CT,'  FULL TITLE IS : ',ALBUM[CT].TITLE);
  134.                 WRITE('AVAILABLE BY : ',ALBUM[CT].ARTIST);
  135.                 WRITELN('  CATAGORY : ',ALBUM[CT].CAT);
  136.               END
  137.             ELSE
  138.               BEGIN
  139.                 WRITELN('FOUND ALBUM # ',CT,'  BY : ',ALBUM[CT].ARTIST);
  140.                 WRITELN('CATAGORY : ',ALBUM[CT].CAT);
  141.               END;
  142.             FOUND:=TRUE;
  143.             WRITELN;
  144.           END;
  145.         IF NOT FOUND THEN
  146.         WRITELN('SORRY, I COULDN''T FIND THAT TITLE IN MY RECORDS.');
  147.         WRITELN;
  148.         WRITE('WOULD YOU LIKE TO CHECK FOR ANOTHER?   Y/N  : ');
  149.         READLN(MORE);
  150.     END;
  151. END;  (* PROECDURE SEARCH_TITLE *)
  152. (****************************************************************************)
  153. PROCEDURE SEARCH_CAT(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  154. VAR CT,COUNT,CAT,LIST:INTEGER;
  155.     CATSTR:STRING[14];
  156.     CHECK:BOOLEAN;
  157.     MORE:CHAR;
  158. BEGIN
  159.   MORE:='Y';
  160.   WHILE MORE='Y' DO
  161.     BEGIN
  162.       CLRSCR;
  163.       WRITELN('CATAGORY SEARCH OPTION');
  164.       WRITE_CATS;
  165.       WRITE('ENTER THE NUMBER OF THE CATAGORY TO SEARCH FOR : ');
  166.       READLN(CAT);
  167.       COUNT:=0;
  168.       LIST:=0;
  169.       GET_CATSTR(CAT,CATSTR);
  170.       CHECK:=TRUE;
  171.       FOR CT:=1 TO NUMRECS DO
  172.         BEGIN
  173.           IF CHECK THEN
  174.             BEGIN
  175.               CHECK:=FALSE;
  176.               CLRSCR;
  177.               WRITELN('TITLES AVAILABLE IN THE ',CATSTR,' CATAGORY ARE :');
  178.               WRITELN;
  179.             END;
  180.           IF CATSTR=ALBUM[CT].CAT THEN
  181.             BEGIN
  182.               WRITELN('ALBUM # ',CT:3,'  TITLE : ',ALBUM[CT].TITLE);
  183.               WRITE('AVAILABLE BY : ',ALBUM[CT].ARTIST);
  184.               WRITELN('  CATAGORY : ',CATSTR);
  185.               WRITELN;
  186.               COUNT:=COUNT+1;
  187.               LIST:=LIST+1;
  188.               CHECK:=(LIST=6);
  189.             END;
  190.           IF CHECK THEN
  191.             BEGIN
  192.               WRITELN;
  193.               WRITELN('HIT ANY KEY TO CONTINUE.');
  194.               LIST:=0;
  195.               WHILE NOT KEYPRESSED DO;
  196.             END;
  197.         END;
  198.       WRITELN;
  199.       IF LIST>=5 THEN CLRSCR;
  200.  WRITELN('THERE ARE A TOTAL OF ',COUNT,' ALBUMS IN THE ',CATSTR,' CATAGORY.');
  201.       WRITELN;
  202.       WRITE('WOULD YOU LIKE TO CHECK ANOTHER CATAGORY?   Y/N   : ');
  203.       READLN(MORE);
  204.     END;
  205. END;  (* PROCEDURE SEARCH_CAT *)
  206. (****************************************************************************)
  207. PROCEDURE SEARCH_COST(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  208. VAR I:INTEGER;
  209.     COST:REAL;
  210.     COUNT,CT:INTEGER;
  211. BEGIN
  212.   CLRSCR;
  213.   WRITELN('COST SEARCH OPTION');
  214.   WRITELN;
  215.   WRITE('ENTER LOWER LIMIT OF COST FOR SEARCH : ');
  216.   READLN(COST);
  217.   CT:=1;
  218.   COUNT:=0;
  219.   WHILE CT<=NUMRECS DO
  220.     BEGIN
  221.       CLRSCR;
  222.       WRITELN('LIST OF ALBUMS WITH COST >= $',COST:1:2);
  223.       WRITELN;
  224.       FOR I:=1 TO 6 DO
  225.         BEGIN
  226.           IF CT<=NUMRECS THEN
  227.             BEGIN
  228.               IF ALBUM[CT].COST>=COST THEN
  229.                 BEGIN
  230.                  WRITELN('ALBUM # ',CT:3,' ALBUM TITLE : ',ALBUM[CT].TITLE);
  231.                  WRITE('BY : ':11,ALBUM[CT].ARTIST);
  232.                  WRITE('  CATAGORY : ',ALBUM[CT].CAT);
  233.                  WRITELN('  COST : $',ALBUM[CT].COST:1:2);
  234.                  WRITELN;
  235.                  COUNT:=COUNT+1;
  236.                 END;
  237.               CT:=CT+1;
  238.             END;
  239.  
  240.         END;
  241.  
  242.       WRITELN('PRESS ANY KEY TO CONTINUE');
  243.       WHILE NOT KEYPRESSED DO;
  244.     END;
  245.       IF CT>=NUMRECS THEN
  246.         BEGIN;
  247.           WRITELN('END OF LISTING:');
  248.           WRITE('TOTAL NUMBER OF ALBUMS WITH COST OVER ',COST:1:2);
  249.           WRITELN(' IS ',COUNT);
  250.           WRITELN
  251.             END;
  252. END;  (* PROCEDURE SEARCH_COST *)
  253. (****************************************************************************)
  254. PROCEDURE READ_FILE(VAR ALBUM:INVENTORY;VAR NUMRECS:INTEGER);
  255. VAR I:INTEGER;
  256. BEGIN
  257.   CLRSCR;
  258.   WRITELN('STAND-BY, READING FILE TO MEMORY.');
  259.   RESET(RECDAT);
  260.   I:=0;
  261.   WHILE NOT EOF(RECDAT) DO
  262.     BEGIN
  263.       I:=I+1;
  264.       GOTOXY(1,3);
  265.       WRITELN('READING RECORD # ',I:3);
  266.       READLN(RECDAT, ALBUM[I].ARTIST);
  267.       READLN(RECDAT, ALBUM[I].TITLE);
  268.       READLN(RECDAT, ALBUM[I].CAT);
  269.       READLN(RECDAT, ALBUM[I].COST);
  270.     END;
  271.   NUMRECS:=I;
  272.   WRITELN;
  273.   WRITELN('FILE READ INTO MEMORY.');
  274.   WRITELN('NUMBER OF RECORDS OCCUPIED IS ',NUMRECS,'.');
  275.   WRITELN;
  276.   DELAY(1000)
  277. END;  (* PROCEDURE READ_FILE *)
  278. (****************************************************************************)
  279. PROCEDURE ENTER_DATA(VAR ALBUM:INVENTORY;VAR NUMRECS:INTEGER);
  280. VAR ARTSTR:STRING[40];
  281.     TITSTR:STRING[50];
  282.     CATSTR:STRING[14];
  283.     RIGHT:CHAR;
  284.     MORE:CHAR;
  285.     CATVAL:INTEGER;
  286.     COST:REAL;
  287. BEGIN
  288.   MORE:='Y';
  289.   WHILE MORE='Y' DO
  290.     BEGIN
  291.       CLRSCR;
  292.       WRITELN('READY TO ENTER NEW RECORD INTO FILE.');
  293.       WRITELN('UPDATING RECORD NUMBER ',NUMRECS+1);
  294.       WRITELN;
  295.       RIGHT:='N';
  296.       WHILE RIGHT='N' DO
  297.         BEGIN
  298.           WRITE('ENTER THE ARTIST''S NAME : ');
  299.           READLN(ARTSTR);
  300.           WRITE('ENTER THE ALBUM TITLE : ');
  301.           READLN(TITSTR);
  302.           WRITE('ENTER THE COST : ');
  303.           READ(COST);
  304.           WRITE_CATS;
  305.           WRITE('ENTER THE CATAGORY NUMBER : ');
  306.           READLN(CATVAL);
  307.           GET_CATSTR(CATVAL,CATSTR);
  308.           WRITE('IS ALL INFORMATION CORRECT?   Y/N  :');
  309.           READLN(RIGHT);
  310.           WRITELN;
  311.         END;
  312.       NUMRECS:=NUMRECS+1;
  313.       ALBUM[NUMRECS].ARTIST:=ARTSTR;
  314.       ALBUM[NUMRECS].TITLE:=TITSTR;
  315.       ALBUM[NUMRECS].CAT:=CATSTR;
  316.       ALBUM[NUMRECS].COST:=COST;
  317.       WRITELN;
  318.       WRITE('ANY MORE ALBUMS TO ENTER?   Y/N  : ');
  319.       READLN(MORE);
  320.     END;
  321. END;  (* PROCEDURE ENTER_DATA *)
  322. (****************************************************************************)
  323. PROCEDURE WRITE_FILE(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  324. VAR I:INTEGER;
  325. BEGIN
  326.   CLRSCR;
  327.   WRITELN('CLOSING OLD FILE');
  328.   CLOSE(RECDAT);
  329.   WRITELN('ERASING OLD FILE');
  330.   ERASE(RECDAT);
  331.   WRITELN('PREPING NEW FILE FOR WRITING');
  332.   REWRITE(RECDAT);
  333.   ALPHABETIZE(ALBUM,NUMRECS);
  334.   FOR I:=1 TO NUMRECS DO
  335.     BEGIN
  336.       GOTOXY(1,10);
  337.       WRITELN('WRITING RECORD # ',I,' TO FILE.');
  338.       WRITELN(RECDAT, ALBUM[I].ARTIST);
  339.       WRITELN(RECDAT, ALBUM[I].TITLE);
  340.       WRITELN(RECDAT, ALBUM[I].CAT);
  341.       WRITELN(RECDAT, ALBUM[I].COST);
  342.     END;
  343.   WRITELN;
  344.   WRITELN('CLOSING NEW FILE');
  345.   CLOSE(RECDAT);
  346.   WRITELN('DONE');
  347.   DELAY(1500)
  348. END;  (* PROCEDURE WRITE_FILE *)
  349. (****************************************************************************)
  350. PROCEDURE UPDATE_RECS(VAR ALBUM:INVENTORY;VAR NUMRECS:INTEGER);
  351. VAR NEWFILE:CHAR;
  352. BEGIN
  353. {  NEWFILE:='X';
  354.   WHILE(NEWFILE<>'Y') AND (NEWFILE<>'N') DO
  355.     BEGIN
  356.       WRITE('CREATE A NEW FILE?   Y/N   : ');
  357.       READLN(NEWFILE);
  358.     END;
  359.   IF NEWFILE='Y' THEN
  360.     BEGIN
  361.       REWRITE(RECDAT);
  362.       CLOSE(RECDAT);
  363.     END; }
  364.   CLRSCR;
  365.   ENTER_DATA(ALBUM,NUMRECS);
  366.   WRITE_FILE(ALBUM,NUMRECS);
  367. END;  (* PROCEDURE UPDATE_RECS *)
  368. (****************************************************************************)
  369. PROCEDURE SEARCH_RECS(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  370. VAR MORE:CHAR;
  371.     SEL:INTEGER;
  372. BEGIN
  373.   MORE:='Y';
  374.   WHILE MORE='Y' DO
  375.     BEGIN
  376.     CLRSCR;
  377.     WRITELN('INVENTORY SEARCH OPTION');
  378.     WRITELN;
  379.     WRITELN('AVAILABLE CHOICES ARE:');
  380.     WRITELN;
  381.     WRITELN('1. SEARCH BY ARTIST');
  382.     WRITELN('2. SEARCH BY TITLE');
  383.     WRITELN('3. SEARCH BY CATAGORY');
  384.     WRITELN('4. SEARCH BY COST');
  385.     WRITELN('5. EXIT TO MAIN PROGRAM');
  386.     WRITELN;
  387.     WRITE('ENTER THE NUMBER OF YOUR CHOICE : ');
  388.     READLN(SEL);
  389.         CASE SEL OF
  390.           1:SEARCH_ARTIST(ALBUM,NUMRECS);
  391.           2:SEARCH_TITLE(ALBUM,NUMRECS);
  392.           3:SEARCH_CAT(ALBUM,NUMRECS);
  393.           4:SEARCH_COST(ALBUM,NUMRECS);
  394.         END;   (* CASE STATEMENT *)
  395.     WRITELN;
  396.     WRITE('WOULD YOU LIKE A SEARCH OF ANOTHER TYPE?   Y/N   : ');
  397.     READLN(MORE);
  398.   END;
  399. END;  (* PROCEDURE SEARCH_RECS *)
  400. (****************************************************************************)
  401. PROCEDURE LIST_RECS(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  402. VAR CT,I:INTEGER;
  403.     CAT:INTEGER;
  404. BEGIN
  405.   CT:=1;
  406.   WHILE CT<=NUMRECS DO
  407.     BEGIN
  408.       CLRSCR;
  409.       WRITELN('LISTING OF ALBUM INVENTORY');
  410.       WRITELN;
  411.       FOR I:=1 TO 6 DO
  412.         BEGIN
  413.           IF CT<=NUMRECS THEN
  414.             BEGIN
  415.               WRITELN('ALBUM # ',CT:3,' ALBUM TITLE : ',ALBUM[CT].TITLE);
  416.               WRITE('BY : ':11,ALBUM[CT].ARTIST);
  417.               WRITELN('  CATAGORY : ',ALBUM[CT].CAT);
  418.               WRITELN;
  419.               CT:=CT+1;
  420.             END;
  421.           IF CT=NUMRECS THEN
  422.             BEGIN;
  423.               WRITELN('END OF LISTING:  TOTAL COUNT IS ',NUMRECS,' ALBUMS.');
  424.               WRITELN
  425.             END;
  426.         END;
  427.       WRITELN('PRESS ANY KEY TO CONTINUE');
  428.       WHILE NOT KEYPRESSED DO;
  429.     END;
  430. END;  (* PROCEDURE LIST_RECS  *)
  431. (****************************************************************************)
  432. PROCEDURE CHANGE_REC(VAR ALBUM:INVENTORY;NUMRECS:INTEGER);
  433. VAR RECNUM:INTEGER;
  434.     I,J:INTEGER;
  435.     SWITCH:INTEGER;
  436.     CAT:INTEGER;
  437.     CORRECT:BOOLEAN;
  438.     ANSWER:CHAR;
  439.     MORE:CHAR;
  440.     COST:REAL;
  441. BEGIN
  442.   MORE:='Y';
  443.   WHILE MORE='Y' DO
  444.     BEGIN
  445.       CLRSCR;
  446.       WRITELN('OPTION TO CHANGE A RECORD');
  447.       CORRECT:=FALSE;
  448.       WHILE NOT CORRECT DO
  449.         BEGIN
  450.           GOTOXY(1,3);
  451.           WRITE('ENTER THE RECORD NUMBER TO BE CHANGED : ');
  452.           READLN(RECNUM);
  453.           WRITELN;
  454.           WRITELN('CURRENT DATA IN RECORD IS AS FOLLOWS :');
  455.           WRITELN('1. ARTIST NAME : ',ALBUM[RECNUM].ARTIST);
  456.           WRITELN('2. ALBUM TITLE : ',ALBUM[RECNUM].TITLE);
  457.           WRITELN('3. CATAGORY    : ',ALBUM[RECNUM].CAT);
  458.           WRITELN('4. COST        : ',ALBUM[RECNUM].COST);
  459.           WRITE('ENTER THE NUMBER OF THE VALUE TO BE CHANGED : ');
  460.           READLN(SWITCH);
  461.           CASE SWITCH OF
  462.             1:BEGIN
  463.                 WRITE('ENTER THE NEW ARTIST NAME : ');
  464.                 READLN(ALBUM[RECNUM].ARTIST);
  465.               END;
  466.             2:BEGIN
  467.                 WRITE('ENTER THE NEW ALBUM TITLE : ');
  468.                 READLN(ALBUM[RECNUM].TITLE);
  469.               END;
  470.             3:BEGIN
  471.                 WRITE_CATS;
  472.                 WRITE('ENTER THE NEW CATAGORY NUMBER : ');
  473.                 READLN(CAT);
  474.                 GET_CATSTR(CAT,ALBUM[RECNUM].CAT);
  475.               END;
  476.             4:BEGIN
  477.                 WRITE('ENTER THE NEW COST : ');
  478.                 READLN(ALBUM[RECNUM].COST);
  479.               END;
  480.           END;  (* CASE STATEMENT *)
  481.           WRITELN('UPDATED DATA IS AS FOLLOWS :');
  482.           WRITELN('ARTIST NAME : ',ALBUM[RECNUM].ARTIST);
  483.           WRITELN('ALBUM TITLE : ',ALBUM[RECNUM].TITLE);
  484.           WRITELN('   CATAGORY : ',ALBUM[RECNUM].CAT);
  485.           WRITELN;
  486.           WRITE('IS THIS CORRECT     Y/N  : ');
  487.           READLN(ANSWER);
  488.           CORRECT:=ANSWER='Y';
  489.         END;
  490.       WRITE('NEED TO UPDATE ANY MORE RECORDS?   Y/N  : ');
  491.       READLN(MORE);
  492.     END;
  493. END;  (* PROCEDURE CHANGE_REC *)
  494. (****************************************************************************)
  495. PROCEDURE DELETE_REC(VAR ALBUM:INVENTORY;VAR NUMRECS:INTEGER);
  496. VAR I,J,RECNUM:INTEGER;
  497. BEGIN
  498.   WRITELN('OPTION TO DELETE A RECORD.');
  499.   WRITELN;
  500.   WRITE('ENTER THE RECORD NUMBER TO BE DELETED : ');
  501.   READLN(RECNUM);
  502.   FOR I:=RECNUM TO NUMRECS-1 DO
  503.     ALBUM[RECNUM]:=ALBUM[RECNUM+1];
  504.   NUMRECS:=NUMRECS-1;
  505. END;  (* PROCEDURE DELETE_REC *)
  506. (****************************************************************************)
  507. PROCEDURE GET_COST
  508. (VAR ALBUMS:INVENTORY;NUMRECS:INTEGER);
  509. VAR I:INTEGER;
  510.     TOTCOST:REAL;
  511. BEGIN
  512.   TOTCOST:=0;
  513.   FOR I:=1 TO NUMRECS DO
  514.     TOTCOST:=TOTCOST+ALBUM[I].COST;
  515.   WRITELN('TOTAL APPROXIMATE COST OF COLLECTION IS $',TOTCOST:1:2);
  516.   WRITELN;
  517.   WRITELN('HIT ANY KEY TO CONTINUE');
  518.   WHILE NOT KEYPRESSED DO;
  519. END;  (* PROCEDURE GET_COST *)
  520. (****************************************************************************)
  521. BEGIN  (* MAIN PROGRAM *)
  522.   ASSIGN(RECDAT,'C:ALBUMS.DTA');
  523.   SEL:=0;
  524.   FILEREAD:=FALSE;
  525.   WHILE SEL<7 DO
  526.     BEGIN
  527.       SEL:=0;
  528.       CLRSCR;
  529.       IF NOT FILEREAD THEN
  530.         READ_FILE(ALBUM,NUMRECS);
  531.       FILEREAD:=TRUE;
  532.       ALPHABETIZE(ALBUM,NUMRECS);
  533.       CLRSCR;
  534.       WRITELN('ALBUM INVENTORY PROGRAM                BY STEVE ROWLAND');
  535.       WRITELN('WRITTEN IN TURBO PASCAL                    JULY 1984');
  536.       WRITELN;
  537.       WRITELN('AVAILABLE OPTIONS ARE :');
  538.       WRITELN;
  539.       WRITELN('1. UPDATE THE INVENTORY');
  540.       WRITELN('2. SEARCH THE INVENTORY');
  541.       WRITELN('3. LIST THE INVENTORY TO THE PRINTER');
  542.       WRITELN('4. CHANGE A RECORD IN THE INVENTORY');
  543.       WRITELN('5. DELETE A RECORD IN THE INVENTORY');
  544.       WRITELN('6. FIND APPROXIMATE COST OF INVENTORY');
  545.       WRITELN('7. END THE PROGRAM AND RETURN TO THE SYSTEM');
  546.       WRITELN;
  547.       WHILE (SEL<1) OR (SEL>7) DO
  548.         BEGIN
  549.           WRITE('ENTER THE NUMBER OF YOUR SELECTION : ');
  550.           READLN(SEL);
  551.           IF (SEL<1) OR (SEL>7) THEN
  552.             WRITE(#7);
  553.         END;
  554.       CASE SEL OF
  555.         1:UPDATE_RECS(ALBUM,NUMRECS);
  556.         2:SEARCH_RECS(ALBUM,NUMRECS);
  557.         3:LIST_RECS(ALBUM,NUMRECS);
  558.         4:CHANGE_REC(ALBUM,NUMRECS);
  559.         5:DELETE_REC(ALBUM,NUMRECS);
  560.         6:GET_COST(ALBUM,NUMRECS);
  561.       END;  (* CASE STATEMENT *)
  562.  
  563.     END;
  564.   END.
  565.